home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / frte.zip / FRTE.PAS < prev    next >
Pascal/Delphi Source File  |  1991-01-06  |  25KB  |  586 lines
  1. {$R-,S-,I-,D-,F-,V-,B-,N-,L+ }
  2. Unit FRTE;
  3. (****************************************************************
  4.  FORCED RUNTIME ERROR WITH ADDRESS UNIT
  5.  FRTE5
  6.  
  7.  Version 3.0
  8.  
  9.  This is an experimental unit that provides a way for your
  10.  "polished" procedures and functions to use TURBOs runtime error
  11.  trapping support just as it does for TURBO's own system level
  12.  procedures and functions.
  13.  
  14.  Many of the units we are now seeing generate error codes when the
  15.  procedures and functions in the unit are passed bad or invalid data.
  16.  These are normally handled one of four ways,
  17.  1) the program is halted with an error code (worst case),
  18.  2) a function like TURBO's ioresult function is used to test to
  19.     see if any errors have occured,
  20.  3) the procedures and functions return an error code which the user must
  21.     test for to detect an error, or
  22.  4) the unit sets a global error variable, which must then be tested.
  23.  
  24.  When you are using porcedures in such a Unit, it is tough to track down
  25.  where in your code these errors are occuring, particularly if you have no
  26.  source code for a unit.  Likely you wrap around each call
  27.  to the unit you are using a routine that checks to see if an error was
  28.  detected our you use the debugger to back step through the program.
  29.  Both of these can often be tedious, can require a lot more code and time,
  30.  which literally clutters up a program.
  31.  
  32.  When you work with TURBO's procedures and functions, for
  33.  example its IO routines, you can set the range and IO compiler flags
  34.  to force TURBO to stop execution on an error, enter the editor, move
  35.  the cursor to the line where the error occured, and diplay an error
  36.  message.  Nice.  Well it was designed that way of course.  Unfortunately,
  37.  user routines do not have the same luxury.  The FRTE unit is an attempt
  38.  to improve this situation.  FRTE allows any procedure to trap an error,
  39.  link into Turbo's runtime error routines, and indicate an error has
  40.  occured, WHERE THE PROCEDURE WAS CALLED, NOT WITHIN THE PROCEDURE ITSELF !
  41.  This makes debugging a LOT easier.
  42.  
  43.  FRTE also allows you to create central error handling routines that can
  44.  make decisions as to how to respond to specific errors, i.e. correct it
  45.  and continue, halt the program, or jump to Turbo's error handling
  46.  routines.
  47.  
  48.  This version will work with TP ver 4.0, 5.0, 5.5, and 6.0.
  49.  This unit is NOT dependent on any other Turbo units.  This version uses
  50.  about 1.5 K of code and data space.  This unit at this time will NOT work
  51.  with Turbo Professional 4.0 or 5.0 TPERRHAN Runtime Error Recovery
  52.  routines (sorry).
  53.  
  54.  
  55.  DOCUMENTATION
  56.  
  57.     procedure FRTError(FRTEaddr:pointer;errorcode:word);
  58.  
  59.       This is the routine that you can use to cause a runtime error
  60.       similar to turbo's internal runtime errors, range errors etc.
  61.       You supply and address where the error occurs, and an error code.
  62.       This routine first shows an error message if ShowFRTEMessage is TRUE.
  63.       Then it calls a runtime error handler function.  A default error
  64.       handler is installed by the initialization code which cause FRTE
  65.       to halt the system via Turbo's error handlers.  In this case if you
  66.       are running under the IDE, the system will halt, the editor will
  67.       be evoked, and the cursor will be placed on the line idenitified
  68.       by FRTEaddr (see Find_FAR_Caller below for details).  However, you can
  69.       install your own routine via InstallFRTE().  The value returned by
  70.       this user installed error handler is used to decide if the error
  71.       will be ignored, if a jump to Turbo's SYSTEM:Runtime error routine
  72.       will be made, or the program will be halted with an ErrorCode.
  73.       When passed on to Turbo's routines with the address where the error
  74.       occured, as defined by FRTEaddr, and the defined error code, the
  75.       system will respond just like it does when Turbo generates a runtime
  76.       error.  If executed under the integrated editor, this will cause the
  77.       compiler to search through the source code for the error location
  78.       passed with FRTEaddr.  It will then place you in the editor at the
  79.       line for FRTEaddr.
  80.  
  81.             Now up to now, not much is different from TURBO's RUNERROR()
  82.       procedure.  However, when you execute RUNERROR(), the error is shown
  83.       to have occured in the line with RUNERROR().  That is not what we
  84.       want.  We want the error to be where our unit was called.
  85.  
  86.       Find_FAR_Caller or Find_NEAR_Caller can be used to determine this
  87.       location.
  88.  
  89.     function Find_Far_Caller(generation:word):pointer;
  90.  
  91.       Find_FAR_Caller is an unusual routine that can trace back a
  92.       history of the location from which far declared procedures and
  93.       functions (that is proceded with a $F+ compiler directive or
  94.       declared in an interface section of a unit, or declared FAR) have
  95.       been called.
  96.       Hmmm ...... This will require a graphic. Take the following code:
  97.  
  98.       {$F+}
  99.             procedure Child;
  100.             begin
  101.               P1 := Find_FAR_Caller(1);
  102.               P2 := Find_FAR_Caller(2);
  103.               P3 := Find_FAR_Caller(3);
  104.               P4 := Find_FAR_Caller(4);
  105.             end;
  106.             procedure Parent;
  107.             begin
  108.               Child;
  109.             end;
  110.             procedure GrandParent;
  111.             begin
  112.               Parent;
  113.             end;
  114.             procedure GreatGrandParent;
  115.             begin
  116.               GrandParent;
  117.             end;
  118.  
  119.       If we call GreatGrandParent by the time it finishes getting done
  120.       with Child,
  121.          P1 will be where Child was called in Parent,
  122.          P2 will be where Parent was called in GrandParent,
  123.          P3 will be where GrandParent was called in GreatGrandParent,
  124.          P4 will be whereever GreatGrandParent was called.
  125.  
  126.  
  127.       This function provides a way to figure out who called the routine
  128.       that caused the error.  This can then be passed to the error routine
  129.       to show the error at the point routine was called, not in routine
  130.       itself.  Find_FAR_Caller(1) would be the location where the last call
  131.       was made, Find_FAR_Caller(2) would be the location of the next to last
  132.       call was made, etc.  So by knowing how far your routine is nested,
  133.       within your own unit, you should be able to find the routine making
  134.       the call into the unit.
  135.  
  136.       Find_Near_Caller (generation:word):pointer;
  137.  
  138.       This functions the same as Find_Far_Caller, except it id used to
  139.       trace through a stack of near (local) procedures and functions.
  140.  
  141.         ShowFRTEMessage : boolean;
  142.  
  143.             This boolean flag is used to determine if FRTE will display and error
  144.             message.  See FRTE_Message below.  This is an easy way to use FRTE
  145.             to display a custom error message without linking into FRTE with
  146.             InstallFRTE.  Normally a UNITS error handling routine will display
  147.             a message so this is FALSE by default.
  148.  
  149.         FRTE_Message : string[40];
  150.  
  151.       FRTE uses FRTEMessage for error display formating if
  152.       ShowFRTEMessage is true.  FRTEMessage must be a string.  Several
  153.       special codes are allowed in this string '#A' means display in
  154.       hexidecimal format the adress where the error occured, '#C'
  155.       means display error code in decimal, '#H' means display error
  156.       code in Hex.
  157.  
  158.         InstallFRTE( UNIT_Error_Handler:FRTE_Handler_type ):word
  159.  
  160.             If you want you can use this routine to link your unit into the FRTE
  161.       system, but this is optional.  If your unit does not call this
  162.       function, the FRTE system will work, but a default error handler will
  163.       be used.  This default error handler will halt the system via TURBO's
  164.       runtime system. (See below for FRTE_handoer_type)
  165.  
  166.       If your unit does use this function, then FRTE will use your own
  167.       custom error handling routine.  InstallFRTE returns the an ID.
  168.       This can be used with the error codes passed to FRTE. (See ERROR
  169.       CODES )  Each time InstallFRTE is called a unique ID will be returned
  170.       for up to 16 calls.  This means multiple units can be using FRTE at
  171.       the same time and FRTE will keep track of them.  If InstallFRTE
  172.       returns 0, then the unit was not installed and the default routine
  173.       will be used.  This can happen only if more than 16 units try to use
  174.       FRTE at once.
  175.  
  176.     type
  177.         FRTE_Handler_Type = function(ErrorAddress:pointer; ErrorCode:word):integer;
  178.  
  179.     This is the type of function to declare for InstallFRTE().  If this
  180.     function returns a 0 then the error is ignored and execution continues
  181.     at the point after FRTE() was called.  If it returns a 1 then
  182.     the FRTE system traps it.  If it returns a -1 then then system is
  183.     halted via the HALT() procedure with the errorcode passed used as the
  184.     DOS error level code passed to HALT().
  185.  
  186.     ErrorAddress is a the same address passed to FRTError and ErrorCode is
  187.     the same value passed to FRTError with the ID stripped out (unless
  188.     defined not to do so) See Below for details.
  189.  
  190.     With in this function you have full access to all of Turbo's procedures
  191.     and functions.  Generating an error code in this routine can result
  192.     in very unpredictable results.
  193.  
  194.  ERROR CODES
  195.  
  196.             When FRTE is used by different UNITS a problem arises.  Two units
  197.             that use FRTE but come from different sources, could end up using the
  198.             same error codes.  This would get mighty confusing to the end user, or
  199.             worse result in bad error handling.  One unit using FRTE may trap
  200.             another units error and do something it shouldn't.  So to prevent this,
  201.       FRTE maintains an array index of errorhandling routines to make sure
  202.       each error is handled by the correct routine.  This requires creating
  203.       an ID for each unit or units that uses FRTE.  The function
  204.           InstallFRTE() returns a word value.  This is an ID that is used with
  205.       the errorcode in FRTError().
  206.  
  207.             Even though TURBO's internal routines error codes currently are less
  208.       than 256, these routines will accept and pass on a full 16 bit word
  209.       error codes. (Version 5.5 and below will not display a code bigger than
  210.       256, ver 6 will display larger values). This allows the use of the high
  211.       nibble of the error code as an id for each unit.  The low byte then
  212.       being the actual error code. This provides a scheme for tagging UNITS
  213.       error codes and keeping them straight.  With this in mind, UNITs error
  214.       handling procedures muts use the following rules.
  215.  
  216.             1) All UNITS must use errorcode less than $1fff.
  217.             2) Second, The InstallFRTE routine is a function that returns a
  218.                  word value.  When a UNIT calls InstallFRTE, the value returned
  219.                  will be the UNIT'S id.  Each unit when it passess an error code
  220.                  to FRTE must OR the errorcode value with its ID.  This will let
  221.                  FRTE know which routine to pass error handling to.  By default FRTE
  222.          will strip off the ID before it passes control to the errorhandling
  223.                  routine.  The error handling routine will receive the 12 bit
  224.          errorcode. (This can be changed by removing the $DEFINE STRIPID in
  225.          the implementation section of this unit.  Leaving the ID attached
  226.          will allow for the creation of central errorhandling routines that
  227.          service multiple units.)
  228.             3) To set some standards (maybe) the following table of error codes
  229.          is suggested for use.
  230.  
  231.                         Error Codes
  232.                  Decimal     Hex           Purpose
  233.                  ------------------    -------
  234.                  1 - 34     $1- $22    Reserved - TURBO's DOS error code list
  235.                  35 - 65    $23-$41    AVAILABLE - Use for DOS related error codes
  236.                                (31 codes available)
  237.                  66 - 99    $42-$63    AVAILABLE - Use for UNIT specific error codes
  238.                                (34 codes available)
  239.                  100 - 118  $64-$76    Reserved - TURBO's IO error codes list
  240.                  119 - 149  $77-$95    AVAILABLE - Use for IO related error codes
  241.                                (31 codes available)
  242.                  150 - 174  $96-$AE    Reserved - TURBO's Critical error codes list
  243.                  175 - 199  $AF-$C7    AVAILABLE - Use for error codes considered
  244.                                critical but which may not need to bring the
  245.                                system to a halt. (25 codes available)
  246.                  200 - 224  $C8-$E0    Reserved TURBO's Fatal Error code list
  247.                  225 - 255  $E1-$FF    AVAILABLE - Use for fatal error codes that
  248.                                likely will require system to halt  (31 error
  249.                                codes available)
  250.                  256 - 511 $100-$1FF   UNIT specific error codes, but use of these
  251.                                                              is discouraged. Refer to note below.
  252.                                                              (256 codes available)
  253.  
  254.                 Units can still use Errorcodes located in the ranges reserved for
  255.                 TURBO if the error code/message matches TURBO's.  For example a unit
  256.                 may need to use a file and cannot find it.  Error codes 2,3,103 etc.
  257.                 may be appropriate.  (Be sure to OR the error code with the Units
  258.         ID.
  259.  
  260.  LIMITATIONS
  261.  
  262.             There are several limitations to this unit as now implemented.
  263.  
  264.             First, the programmer of a UNIT must develop a strategy to trace
  265.             its lineage back to where it was called from the main code.  With
  266.             circular units and units that have a lot of internal (near) calls
  267.             mixed with FAR calls, this can be quite confusing.  A function
  268.             called Get_EVE which requires no generation value, nor does it need
  269.             to be near or far specific is now being played with.   It may be
  270.             included in a future update.
  271.  
  272.             FRTE can be used by only 16 units at one time.  This can be expanded
  273.             via the source code.
  274.  
  275.  
  276.  copyright (C) 1990
  277.  McQuay Technologies
  278.  
  279.  Released into the public domain.........Be nice folks and share the
  280.  credit if credit is due.
  281.  
  282.  ray quay version 3 12/1/90
  283.  
  284.  Compuserve ID 72307,320
  285.  Prodigy ID WPTD01A
  286.  
  287.  McQuay Technologies
  288.  
  289.  2329 E Cortez St
  290.  Phoenix AZ 85028
  291.  
  292.  Suite 291
  293.  8045 Antoine
  294.  Houston TX 77088
  295.  
  296.  
  297. =====================================================================*)
  298. Interface
  299.     type
  300.         FRTE_Handler_Type = function(ErrorAddress:pointer; ErrorCode:word):integer;
  301.     const
  302.         ShowFRTEMessage : boolean = false;
  303.         FRTE_Message : string[40] = 'Extended ErrorCode #C #H at #A';
  304.     function InstallFRTE(Error_Handler:FRTE_Handler_type):word;
  305.     procedure FRTError(FRTEaddr:pointer;errorcode:word);
  306.   function Find_Far_Caller(generation:word):pointer;
  307.     function Find_NEAR_Caller(generation:word):pointer;
  308.  
  309. {=====================================================================}
  310. Implementation
  311.   {$DEFINE STripID}
  312.   const
  313.         MAXUNITS = 16;
  314.         UNITID : word = 0;
  315.         UNITS_Loaded : byte = 0;
  316.     var
  317.     Error_Jump : pointer;
  318.     Error_Jump_Ofs : word;
  319.     BaseSeg : word;
  320.         FRTE_Handler_Table : array[0..MAXUNITS] of
  321.             record
  322.                 ID:word;
  323.                 UNITHandler:FRTE_Handler_Type;
  324.             end;
  325.   {--------------------------------------------------------------------------}
  326.     { Used to display hex values, short and sweet }
  327.   const
  328.     hexchar : array[0..15] of char = ('0','1','2','3','4','5','6','7','8',
  329.                                       '9','A','B','C','D','E','F');
  330.  
  331.   function hexptr(value:pointer):string;
  332.     var
  333.       data : array[0..3] of byte absolute value;
  334.    begin
  335.         hexptr[1] := hexchar[data[3] shr 4];
  336.         hexptr[2] := hexchar[data[3] and $f];
  337.         hexptr[3] := hexchar[data[2] shr 4];
  338.         hexptr[4] := hexchar[data[2] and $f];
  339.         hexptr[6] := hexchar[data[1] shr 4];
  340.         hexptr[7] := hexchar[data[1] and $f];
  341.         hexptr[8] := hexchar[data[0] shr 4];
  342.         hexptr[9] := hexchar[data[0] and $f];
  343.       hexptr[5] := ':';
  344.         hexptr[0] := char(9);
  345.    end;
  346.   function hexword(value:word):string;
  347.     var
  348.       data : array[0..1] of byte absolute value;
  349.    begin
  350.         hexword[1] := hexchar[data[1] shr 4];
  351.         hexword[2] := hexchar[data[1] and $f];
  352.         hexword[3] := hexchar[data[0] shr 4];
  353.         hexword[4] := hexchar[data[0] and $f];
  354.         hexword[0] := char(4);
  355.    end;
  356.   {$F+}
  357.   {--------------------------------------------------------------------------}
  358.     { This function provides away to figure out who called the routine
  359.       that caused the error.  This can then be passed to the error routine
  360.       to show the error at the point routine was called, not in routine
  361.       itself.  Find_FAR_Caller(1) would be the location where the last call
  362.       was made, Find_FAR_Caller(2) would be the location of the next to last
  363.       call was made, etc.  So by knowing how far your routine is nested, you
  364.       should be able to find the routine making the call into the unit.
  365.  
  366.     }
  367.   function Find_FAR_Caller(generation:word):pointer;
  368.   begin
  369.     inline(
  370.       $8B/$4E/$06/     {        MOV     CX,[BP+06]  ; get genreation }
  371.       $8B/$5E/$00/     {        MOV     BX,[BP+00]  ; get BP calling }
  372.       $E2/$02/         { start  LOOP getBP       ; if CX >1 loop  }
  373.       $EB/$05/         {        JMP  getadr      ; OK get address }
  374.       $36/$8B/$1F/     { getBP  MOV     BX,SS:[BX]  ; get next BP    }
  375.       $EB/$F7/         {        JMP  start       ; go to check    }
  376.       $36/$8B/$47/$02/ { getadr MOV     AX,[BX+02]  ; get offset     }
  377.       $36/$8B/$57/$04/ {        MOV     DX,[BX+04]  ; get segment    }
  378.       $2D/$07/$00/     {        SUB  AX,07h      ; adjust for call}
  379.       $89/$EC/         {        MOV  sp,bp       ; scrap scratch  }
  380.       $5D/             {        POP  bp          ; get BP         }
  381.       $CA/$02/$00);    {        RTN far 0002     ; return         }
  382.   end;
  383.  
  384.     function Find_Near_Caller(generation:word):pointer;
  385.   begin
  386.     inline(
  387.       $8B/$4E/$06/     {        MOV     CX,[BP+06]  ; get genreation }
  388.       $8B/$5E/$00/     {        MOV     BX,[BP+00]  ; get BP calling }
  389.       $E2/$02/         { start  LOOP getBP       ; if CX >1 loop  }
  390.       $EB/$05/         {        JMP  getadr      ; OK get address }
  391.       $36/$8B/$1F/     { getBP  MOV     BX,SS:[BX]  ; get next BP    }
  392.       $EB/$F7/         {        JMP  start       ; go to check    }
  393.             $36/$8B/$47/$02/ { getadr MOV     AX,[BX+02]  ; get offset      }
  394.             $36/$8B/$57/$04/ {        MOV     DX,[BP+02]  ; get near segment}
  395.       $2D/$07/$00/     {        SUB  AX,07h      ; adjust for call}
  396.       $89/$EC/         {        MOV  sp,bp       ; scrap scratch  }
  397.       $5D/             {        POP  bp          ; get BP         }
  398.       $CA/$02/$00);    {        RTN far 0002     ; return         }
  399.   end;
  400.  
  401.  
  402.  
  403. {---------------------------------------------------}
  404.  
  405. function get_int_seg(interrupt_number:word):word;
  406.  { This function uses DOSs get interrupt vector function $35, so
  407.    we do not need to include Turbos DOS unit. }
  408.   inline
  409.     ( $58/         { pop ax     }
  410.       $B4/$35/     { mov ah,35h }
  411.       $CD/$21/     { int 21h    }
  412.       $8C/$C0);    { mov ax,es  }
  413.  
  414. procedure incptr(var P:pointer;increment:word);
  415.   { This is an inline directive that increments a pointer but !!
  416.     it makes no checks to see if there was an overflow !!!          }
  417.   inline(
  418.     $58/                        { pop ax              ;get increment size }
  419.     $5F/                        { pop di              ;get p's offset     }
  420.     $07/                        { pop es              ;get p's segment    }
  421.     $26/$01/$05);               { add es:[di],ax      ;increment offset   }
  422.  
  423. {---------------------------------------------------}
  424. const
  425.   trapid : array[1..4] of byte = ($59,$5B,$EB,$BA);
  426.  
  427. function find_error_entry:pointer;
  428. var
  429.   byteptr : ^byte;
  430.   wordptr : ^word absolute byteptr;
  431.   aptr : pointer absolute byteptr;
  432.   trapptr : pointer;
  433. begin
  434.  byteptr := ptr(get_int_seg(0),1);
  435.  while (( ofs(byteptr^)<$300 ) and ( ofs(byteptr^)>0) ) do
  436.    begin
  437.    if (byteptr^ = trapid[1]) then
  438.     begin
  439.     trapptr := byteptr;
  440.     incptr(aptr,1);
  441.     if (byteptr^ = trapid[2]) then
  442.       begin
  443.       incptr(aptr,1);
  444.       if (byteptr^ = trapid[3]) then
  445.         begin
  446.         incptr(aptr,1);
  447.         incptr(aptr,byteptr^ + 1);
  448.         if (byteptr^ = trapid[4]) then
  449.           begin
  450.           incptr(aptr,1);
  451.           if wordptr^ = Dseg then
  452.             begin
  453.             find_error_entry := trapptr;
  454.             exit;
  455.           end;
  456.         end;
  457.       end;
  458.     end;
  459.    end;
  460.    incptr(aptr,1);
  461.   end;
  462.   find_error_entry := nil;
  463. end;
  464. {---------------------------------------------------}
  465.  
  466.   {--------------------------------------------------------------------------}
  467.   {$F+}
  468.     { This is the routine that determines disposition of the user error.  It
  469.       returns an integer.  This value is used to determine action on error.
  470.         1  - stop program and jump to Turbo's runtime routines, pass address.
  471.         0  - do not halt program (user has option to set error flags.
  472.        -1  - halt program, bypass Turbo runtime, put error in dos error flag.
  473.  
  474.      EC is the ErrorCode detected, EA is the address where the error occured.
  475.     }
  476.  
  477.   function Default_FRTE_Handler(EA:pointer;EC:word):integer;
  478.   begin
  479.     Default_FRTE_Handler := 1;
  480.   end;
  481.  
  482. {---------------------------------------------------}
  483.     function InstallFRTE(Error_Handler:FRTE_Handler_Type):word;
  484.     begin
  485.         if Units_Loaded = MAXUNITS then InstallFRTE := 0
  486.         else
  487.             begin
  488.             inc(Units_Loaded);
  489.             UNITID := UNITID + $200;
  490.             FRTE_Handler_Table[Units_Loaded].ID := UNITID;
  491.             FRTE_Handler_Table[Units_Loaded].UNITHandler := Error_Handler;
  492.             InstallFRTE := UNITID;
  493.             end;
  494.      end;
  495.   {--------------------------------------------------------------------------}
  496.   procedure FRTError(FRTEaddr:pointer;errorcode:word);
  497.  
  498.   { This routine first shows an error message if ShowFRTEMessage is TRUE.
  499.     Then it calls a runtime error handler.  A default is installed by
  500.     the initialization code, but another can be installed via
  501.     FRTE_handler_Vector.  The value returned by this function is used to
  502.     decide if the error will be ignored, if jump to Turbo's SYSTEM:Runtime
  503.     error routine will be made, or the program will be halted with an
  504.     ErrorCode.  If passed on to Turbo's routines, the location where
  505.     the error occured, as defined by FRTEaddr, and the error code is
  506.     passsed on to Turbo's rtuntime error routines.  If executed under the
  507.     integrated editor, this will cause compiler to search through the source
  508.     code for the error location passed with FRTEaddr.
  509.  
  510.     Get_FAR/NEAR_Caller can be used to determine the location where
  511.     the routine was called from.  This makes debugging code that uses
  512.     "air tight" units a lot easier because any state that the unit
  513.     considers a runtime error, can be trapped and the location of the
  514.     offending call found by the integrated editor.
  515.  
  516.     This routine uses FRTEMessage for error display formating if
  517.     ShoeFRTEMessage is true.  FRTEMessage must be a string.  Several
  518.     special codes are allowed in this string '#A' means display in
  519.     hexidecimal format the adress where error occured as defined by
  520.     FRTEaddr, '#C' means display error code in decimal, '#H' means
  521.     display error code in Hex.
  522.      }
  523.   var
  524.      i:integer;
  525.      j:word;
  526.   begin
  527.  
  528.     if ShowFRTEMessage then
  529.       begin
  530.       for i:=1 to length(FRTE_message) do
  531.         if (FRTE_message[i]='#') then
  532.           begin
  533.           inc(i);
  534.           case FRTE_message [i] of
  535.             'A': write('$',hexptr(FRTEaddr));
  536.             'C': write(errorcode);
  537.             'H': write('$',hexword(errorcode));
  538.           end;
  539.           end
  540.         else
  541.           write(FRTE_message[i]);
  542.       writeln;
  543.             end;
  544.  
  545.         j:=1;
  546.         i:=Errorcode and $FE00;
  547.         while (FRTE_handler_table[j].ID <> i)and(j<=UNITS_LOADED) do
  548.             inc(j);
  549.         if j>Units_Loaded then j:=0;
  550.   {$IFDEF StripID}
  551.         if j>0 then errorcode := Errorcode xor i;
  552.   {$ENDIF}
  553.     i := FRTE_HANDLER_TAble[j].UnitHandler(FRTEaddr,ErrorCode);
  554.     case i of
  555.       1: inline (
  556.             $89/$EC/                  { mov sp,bp ;restore sp    }
  557.             $5D/                      { pop BP    ;restore BP     }
  558.             $58/                      { pop ax    ;trash rtnaddr  }
  559.             $58/                      { pop ax                    }
  560.             $58/                      { pop ax     ;get errorcode }
  561.               $8B/$36/error_jump_ofs/   { mov si,     error_jump_ofs  }
  562.             $FF/$2c);                 { jmp far ptr [si] ;jmp!    }
  563.        -1:halt(errorcode);
  564.         0:exit;
  565.       end;
  566.   end;
  567.  
  568. {--------------------------------------------------------------------------}
  569. begin
  570.   { get CS of main PROGRAM }
  571.     inline(
  572.            $8B/$46/$02/         { mov ax,[bp+2] }
  573.            $A3/BaseSeg );       { mov BaseSeg,ax }
  574.  
  575.   error_jump := find_error_entry;
  576.   if error_jump = nil then
  577.     begin
  578.         writeln(' FRTE Not Installed! ');
  579.     halt;
  580.     end;
  581.   error_jump_ofs := ofs(error_jump);
  582.     FRTE_Handler_table[0].UNITHandler := Default_FRTE_handler;
  583. end.
  584.  
  585.  
  586.